home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / yahtze1a / modgener.bas < prev    next >
BASIC Source File  |  1999-09-27  |  7KB  |  190 lines
  1. Attribute VB_Name = "modGeneral"
  2. Option Explicit
  3.  
  4. '//Public Members
  5. Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
  6. Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  7.  
  8. '//Private Constants
  9. Private Const SND_ASYNC = &H1
  10. Private Const SND_NODEFAULT = &H2
  11.  
  12. '//Public Constants
  13. Global Const MyApp = "MTCYahtzee"  '//Registry key used for storing data
  14.  
  15. '//Public variables
  16. Public Bonus63 As Integer   '//Left column bonus scoring countdown
  17. Public lColTotal As Integer '//Left column total score
  18. Public rColTotal As Integer '//Right column total score
  19. Public GameTotal As Integer '//Game total
  20. Public HSPosition As Integer '//High score position
  21.  
  22. '//Wav file playing subroutine
  23. Public Sub PlaySound(strSound As String)
  24. Dim wFlags%
  25.     
  26.   wFlags% = SND_ASYNC Or SND_NODEFAULT
  27.   sndPlaySound strSound, wFlags%
  28.  
  29. End Sub
  30.  
  31. '//Get values from registry
  32. Public Sub CheckReg()
  33. Dim strCheckReg(2) As String
  34. Dim midX As Long
  35. Dim midY As Long
  36.  
  37.   '//Get center screen values
  38.   midX = ((Screen.Width / 2) - (frmMain.Width / 2))
  39.   midY = ((Screen.Height / 2) - (frmMain.Height / 2))
  40.   
  41.   '//Restore previous screen position
  42.   frmMain.Left = GetSetting(MyApp, "Settings", "MainLeft", midX)
  43.   frmMain.Top = GetSetting(MyApp, "Settings", "MainTop", midY)
  44.   
  45.   '//See if sound is on or off
  46.   frmMain.mnuSound.Checked = GetSetting(MyApp, "Settings", "Sound", "True")
  47.   
  48.   '//If never played before add default values to registry
  49.   strCheckReg(1) = GetSetting(MyApp, "Settings", "HSName1")
  50.   strCheckReg(2) = GetSetting(MyApp, "Settings", "GamesPlayed")
  51.  
  52.   If strCheckReg(1) = "" And strCheckReg(2) = "" Then
  53.     Call ResetHighScores
  54.     Call ResetStats
  55.   End If
  56.  
  57. End Sub
  58.  
  59. '//Add last game to statistics in registry
  60. Public Sub UpdateStats(Score As Integer)
  61. Dim Stat(2) As Long
  62.  
  63.   Stat(1) = CLng(GetSetting(MyApp, "Settings", "GamesPlayed", "0"))
  64.   Stat(2) = CLng(GetSetting(MyApp, "Settings", "TotalScore", "0"))
  65.  
  66.   Stat(1) = CLng(Stat(1)) + 1
  67.   Stat(2) = CLng(Stat(2)) + Score
  68.  
  69.   SaveSetting MyApp, "Settings", "GamesPlayed", Stat(1)
  70.   SaveSetting MyApp, "Settings", "TotalScore", Stat(2)
  71.  
  72. End Sub
  73.  
  74. '//Reset statistics in registry
  75. Public Sub ResetStats()
  76.   
  77.   SaveSetting MyApp, "Settings", "GamesPlayed", "0"
  78.   SaveSetting MyApp, "Settings", "TotalScore", "0"
  79.  
  80. End Sub
  81.  
  82. '//Reset all high scores in registry!
  83. Public Sub ResetHighScores()
  84.   
  85.   SaveSetting MyApp, "Settings", "HSName0", "Shannon Harmon"
  86.   SaveSetting MyApp, "Settings", "HSName1", "Amy Kellar"
  87.   SaveSetting MyApp, "Settings", "HSName2", "Thomas Allen"
  88.   SaveSetting MyApp, "Settings", "HSName3", "John Baringer"
  89.   SaveSetting MyApp, "Settings", "HSName4", "Denise Allen"
  90.   SaveSetting MyApp, "Settings", "HSScore0", "300"
  91.   SaveSetting MyApp, "Settings", "HSScore1", "275"
  92.   SaveSetting MyApp, "Settings", "HSScore2", "250"
  93.   SaveSetting MyApp, "Settings", "HSScore3", "225"
  94.   SaveSetting MyApp, "Settings", "HSScore4", "200"
  95.  
  96. End Sub
  97.  
  98. '//See if last games total was high enough to be listed in top 5 players
  99. Public Function CheckForHS() As Boolean
  100. Dim Name0 As String, Name1 As String, Name2 As String, Name3 As String, Name4 As String
  101. Dim Score0 As Integer, Score1 As Integer, Score2 As Integer, Score3 As Integer, Score4 As Integer
  102. Dim i As Integer
  103. Dim NewHSName As String
  104.  
  105.   Name0 = GetSetting(MyApp, "Settings", "HSName0", "Default")
  106.   Name1 = GetSetting(MyApp, "Settings", "HSName1", "Default")
  107.   Name2 = GetSetting(MyApp, "Settings", "HSName2", "Default")
  108.   Name3 = GetSetting(MyApp, "Settings", "HSName3", "Default")
  109.   Name4 = GetSetting(MyApp, "Settings", "HSName4", "Default")
  110.   Score0 = GetSetting(MyApp, "Settings", "HSScore0", "Default")
  111.   Score1 = GetSetting(MyApp, "Settings", "HSScore1", "Default")
  112.   Score2 = GetSetting(MyApp, "Settings", "HSScore2", "Default")
  113.   Score3 = GetSetting(MyApp, "Settings", "HSScore3", "Default")
  114.   Score4 = GetSetting(MyApp, "Settings", "HSScore4", "Default")
  115.  
  116.   If GameTotal > Score4 Then
  117.     
  118.     NewHSName = InputBox("NEW HIGH SCORE" + Chr(13) + Chr(13) + "Please enter your name", "Yahtzee Deluxe")
  119.     
  120.     If GameTotal > Score4 And GameTotal <= Score3 Then
  121.       
  122.       SaveSetting MyApp, "Settings", "HSScore4", GameTotal
  123.       SaveSetting MyApp, "Settings", "HSName4", NewHSName
  124.       HSPosition = 4
  125.     
  126.     End If
  127.     
  128.     If GameTotal > Score3 And GameTotal <= Score2 Then
  129.       
  130.       SaveSetting MyApp, "Settings", "HSScore3", GameTotal
  131.       SaveSetting MyApp, "Settings", "HSName3", NewHSName
  132.       SaveSetting MyApp, "Settings", "HSScore4", Score3
  133.       SaveSetting MyApp, "Settings", "HSName4", Name3
  134.       HSPosition = 3
  135.     
  136.     End If
  137.     
  138.     If GameTotal > Score2 And GameTotal <= Score1 Then
  139.       
  140.       SaveSetting MyApp, "Settings", "HSScore2", GameTotal
  141.       SaveSetting MyApp, "Settings", "HSName2", NewHSName
  142.       SaveSetting MyApp, "Settings", "HSScore3", Score2
  143.       SaveSetting MyApp, "Settings", "HSName3", Name2
  144.       SaveSetting MyApp, "Settings", "HSScore4", Score3
  145.       SaveSetting MyApp, "Settings", "HSName4", Name3
  146.       HSPosition = 2
  147.     
  148.     End If
  149.     
  150.     If GameTotal > Score1 And GameTotal <= Score0 Then
  151.       
  152.       SaveSetting MyApp, "Settings", "HSScore1", GameTotal
  153.       SaveSetting MyApp, "Settings", "HSName1", NewHSName
  154.       SaveSetting MyApp, "Settings", "HSScore2", Score1
  155.       SaveSetting MyApp, "Settings", "HSName2", Name1
  156.       SaveSetting MyApp, "Settings", "HSScore3", Score2
  157.       SaveSetting MyApp, "Settings", "HSName3", Name2
  158.       SaveSetting MyApp, "Settings", "HSScore4", Score3
  159.       SaveSetting MyApp, "Settings", "HSName4", Name3
  160.       HSPosition = 1
  161.     
  162.     End If
  163.     
  164.     If GameTotal > Score0 Then
  165.       
  166.       SaveSetting MyApp, "Settings", "HSScore0", GameTotal
  167.       SaveSetting MyApp, "Settings", "HSName0", NewHSName
  168.       SaveSetting MyApp, "Settings", "HSScore1", Score0
  169.       SaveSetting MyApp, "Settings", "HSName1", Name0
  170.       SaveSetting MyApp, "Settings", "HSScore2", Score1
  171.       SaveSetting MyApp, "Settings", "HSName2", Name1
  172.       SaveSetting MyApp, "Settings", "HSScore3", Score2
  173.       SaveSetting MyApp, "Settings", "HSName3", Name2
  174.       SaveSetting MyApp, "Settings", "HSScore4", Score3
  175.       SaveSetting MyApp, "Settings", "HSName4", Name3
  176.       HSPosition = 0
  177.     
  178.     End If
  179.     
  180.     CheckForHS = True
  181.  
  182.   Else
  183.   
  184.     CheckForHS = False
  185.   
  186.   End If
  187.  
  188. End Function
  189.  
  190.